Celestin Apprentice 4

home *** CD-ROM | disk | FTP | other *** search

/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacQForth 1.0 / source / QF Source / QF.REGWRDS1.S < prev next >

Wrap

Text File | 1995-03-06 | 9KB | 417 lines

* * Word "r@" - Copy value from return stack to data stack * WORD51 ASC 'r@ ' DW RFETCH RFETCH JSR POPRETN JSR PUSHRETN JMP PUSHDATA * * Word "." - Print out top number on stack as signed integer * WORD52 ASC '. ' DW DOT DOT JSR POPDATA JMP PRTSIGND * * Word "u." - print out top number on stack as unsigned int * WORD53 ASC 'u. ' DW U_DOT U_DOT JSR POPDATA JMP PRTDEC * * Word "not" - do logical NOT on top number * * Note: Bypasses POPDATA, PUSHDATA for speed * WORD54 ASC 'not ' DW NOT NOT LDA DATITEMS ; Make sure there's something on stack BEQ :ERROR ; to negate LDY DATSTACK LDA DATAAREA+1,Y ORA DATAAREA+2,Y BNE :FALSE LDA #$FF HEX 2C ; BIT trick :FALSE LDA #00 STA DATAAREA+1,Y STA DATAAREA+2,Y RTS :ERROR LDA #04 ; "Data stack underflow" JMP PRTERR * * Word "and" - perform logical AND on top two stack items * WORD55 ASC 'and ' DW AND AND JSR POPDATA STY TEMP TXA ORA TEMP STA TEMP BEQ :FALSE JSR POPDATA STY TEMP TXA ORA TEMP STA TEMP BEQ :FALSE2 LDX #$FF LDY #$FF JMP PUSHDATA :FALSE JSR POPDATA :FALSE2 LDX #$00 LDY #$00 JMP PUSHDATA * * Word "or" - Perform logical OR on top two stack items * WORD56 ASC 'or ' DW OR OR JSR POPDATA STY TEMP TXA ORA TEMP STA TEMP JSR POPDATA TYA ORA TEMP STA TEMP TXA ORA TEMP STA TEMP BNE :TRUE LDX #$00 LDY #$00 JMP PUSHDATA :TRUE LDX #$FF LDY #$FF JMP PUSHDATA * * Word "xor" - Do logical XOR on top two stack items * WORD57 ASC 'xor ' DW XOR XOR JSR POPDATA STY TEMP TXA ORA TEMP BEQ :ZERO LDA #$FF HEX 2C :ZERO LDA #$00 STA TEMP JSR POPDATA STY TEMP2 TXA ORA TEMP2 BEQ :ZERO2 LDA #$FF HEX 2C :ZERO2 LDA #$00 EOR TEMP TAY TAX JMP PUSHDATA * * Word "+" - Add two numbers on stack, * leave result on stack * WORD58 ASC '+ ' DW ADD ADD JSR POPDATA STY TEMP STX TEMP+1 JSR POPDATA TYA CLC ADC TEMP TAY TXA ADC TEMP+1 TAX JMP PUSHDATA * * Word "-" - Subtract top word from next-top word, * leave result on stack * WORD59 ASC '- ' DW MINUS MINUS JSR POPDATA STY TEMP STX TEMP+1 JSR POPDATA TYA SEC SBC TEMP TAY TXA SBC TEMP+1 TAX JMP PUSHDATA * * Word "*" - Multiply two numbers on stack, * leave result on stack (signed) * WORD60 ASC '* ' DW ASTERISK ASTERISK JSR GETNUMS ; Fetch two signed integers STZ TEMP LDY #00 LDX #16 :LOOP LSR PNTR+1 ROR PNTR BCC :SKIPADD TYA CLC ADC PNTR2 TAY LDA PNTR2+1 ADC TEMP STA TEMP :SKIPADD ASL PNTR2 ROL PNTR2+1 DEX BNE :LOOP LDX TEMP BIT TEMP2 ; Check for negative BPL :NOTNEG TYA EOR #$FF CLC ADC #01 TAY TXA EOR #$FF ADC #00 TAX :NOTNEG JMP PUSHDATA * * GETNUMS - subroutine for fetching two signed numbers * (called by ASTERISK, SLASH, MOD) * GETNUMS JSR POPDATA ; Get first number and store sign TXA BPL :POS LDA #$FF STA TEMP2 TYA EOR #$FF CLC ADC #01 STA PNTR TXA EOR #$FF ADC #00 STA PNTR+1 BRA :MERGE :POS STZ TEMP2 STY PNTR STX PNTR+1 :MERGE JSR POPDATA ; Get second number and store sign TXA BPL :POS2 LDA TEMP2 EOR #$FF ; Invert high bit of TEMP2 STA TEMP2 TYA EOR #$FF CLC ADC #01 STA PNTR2 TXA EOR #$FF ADC #00 STA PNTR2+1 RTS :POS2 STY PNTR2 STX PNTR2+1 RTS * * Word "/" - Divide two numbers on stack, * leave result on stack * WORD61 ASC '/ ' DW SLASH SLASH JSR GETNUMS JSR DIVSUB LDY PNTR2 LDX PNTR2+1 BIT TEMP2 BPL :POSITIV TYA EOR #$FF CLC ADC #01 TAY TXA EOR #$FF ADC #00 TAX :POSITIV JMP PUSHDATA * * DIVSUB - subroutine for division * (called by SLASH, MOD) * DIVSUB LDA PNTR ORA PNTR+1 BEQ :ERROR STZ PNTR3 STZ PNTR3+1 LDX #16 :LOOP ASL PNTR2 ROL PNTR2+1 ROL PNTR3 ROL PNTR3+1 LDA PNTR3 SEC SBC PNTR TAY LDA PNTR3+1 SBC PNTR+1 BCC :NOGOOD STA PNTR3+1 STY PNTR3 LDA PNTR2 ORA #01 STA PNTR2 :NOGOOD DEX BNE :LOOP RTS :ERROR LDA #$0E ; "Division by zero" JMP PRTERR * * Word "mod" - Divide two numbers on stack, * leave modulus on stack * WORD62 ASC 'mod ' DW MOD MOD JSR POPDATA ; Get first number and ignore sign TXA BPL :POS TYA EOR #$FF CLC ADC #01 STA PNTR TXA EOR #$FF ADC #00 STA PNTR+1 BRA :MERGE :POS STY PNTR STX PNTR+1 :MERGE JSR POPDATA ; Get second number and store sign TXA BPL :POS2 LDA #$FF STA TEMP2 TYA EOR #$FF CLC ADC #01 STA PNTR2 TXA EOR #$FF ADC #00 STA PNTR2+1 BRA :MERGE2 :POS2 STZ TEMP2 STY PNTR2 STX PNTR2+1 :MERGE2 JSR DIVSUB LDY PNTR3 ; Set sign of modulus to same as dividend LDX PNTR3+1 BIT TEMP2 BPL :POSITIV TYA EOR #$FF CLC ADC #01 TAY TXA EOR #$FF ADC #00 TAX :POSITIV JMP PUSHDATA ******************************** * End regular words 1 ********************************